home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
mpfeel.lha
/
MPFeel
/
Modules
/
avl-macros.em
next >
Wrap
Text File
|
1992-10-06
|
3KB
|
96 lines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; EuLisp Module Copyright (C) University of Bath 1991 ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File: avl-macros.em
; Title: AVL tree module utility
; Author: Julian Padget revised Arthur Norman's code.
;
; (c) Copyright 1990, University of Bath, all rights reserved
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Revisions:
; 21-APR-90 (Julian Padget) Code originally comes from Cambridge Lisp and
; was written by Arthur Norman. Mohammed Awdeh and John Fitch made it work
; in PSL and JAP tarted it up with defstruct and modules for EuLisp/PSL
; 09-NOV-90 (Keith Playford) Becomes avl.em for EuLisp compilation. Removed
; progs. Split macros.
; 10-NOV-90 (Julian Padget) Remmoved avl-prog macro having modified avl.em
; to make it superfluous.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmodule avl-macros
;; ( lists list-operators others classes class-names defs) ()
(lists list-operators others classes defs
(except (null) class-names))
()
; tree node access operators
; EuLispised (kjp)
( avl-macros)
;; (export
(ldefstruct key-value ()
((key
initarg key
accessor key)
(value
initarg value
accessor value))
constructor make-key-value)
(ldefstruct tree ()
((key-value-pair
initarg key-value-pair
accessor key-value-pair)
(avl-left
initarg avl-left
accessor avl-left)
(avl-right
initarg avl-right
accessor avl-right)
(balance-state
initarg balance-state
accessor balance-state))
constructor make-tree)
(ldefstruct avl-tree ()
((order
initarg order
reader avl-tree-order)
(equality
initarg equality
reader avl-tree-equality)
(tree
initform ()
initarg tree
accessor avl-tree-tree))
constructor make-avl-tree)
(defmacro avl-key (tree) `(key (key-value-pair ,tree)))
(defmacro avl-value (tree) `(value (key-value-pair tree)))
(defmacro avl-balanced (tree) `(eq (balance-state tree) 0))
(defmacro avl-left-unbalanced (tree) `(eq (balance-state tree) 1))
(defmacro avl-right-unbalanced (tree) `(eq (balance-state tree) 2))
(defmacro avl-double-unbalanced (tree) `(eq (balance-state tree) 3))
(defmacro mark-balanced (tree) `((setter balance-state) tree 0))
(defmacro mark-left-unbalanced (tree) `((setter balance-state) tree 1))
(defmacro mark-right-unbalanced (tree) `((setter balance-state) tree 2))
(defmacro mark-double-unbalanced (tree) `((setter balance-state) tree 3))
;; )
)